;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: snark-sparse-array -*-
;;; File: sparse-vector3.lisp
;;; The contents of this file are subject to the Mozilla Public License
;;; Version 1.1 (the "License"); you may not use this file except in
;;; compliance with the License. You may obtain a copy of the License at
;;; http://www.mozilla.org/MPL/
;;;
;;; Software distributed under the License is distributed on an "AS IS"
;;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
;;; License for the specific language governing rights and limitations
;;; under the License.
;;;
;;; The Original Code is SNARK.
;;; The Initial Developer of the Original Code is SRI International.
;;; Portions created by the Initial Developer are Copyright (C) 1981-2006.
;;; All Rights Reserved.
;;;
;;; Contributor(s): Mark E. Stickel <stickel@ai.sri.com>.

(in-package :snark-sparse-array)

;;; ****if* snark-sparse-array/sparse-vector-types
;;; SOURCE

(deftype sparse-vector-index () 'integer)	;indexes are integers
(deftype sparse-vector-count () 'fixnum)	;number of entries is a fixnum
;;; ***

;;; more implementation independent sparse-vector functions are defined in sparse-array.lisp

#+snark-sparse-vector-statistics
(defvar *statistics* nil)

#+snark-sparse-vector-statistics
(defstruct sparse-vector-stat
  (boolean nil :read-only t)
  (assignment-count 0 :type integer)
  (random-access-count 0 :type integer)
  (forward-sequential-access-count 0 :type integer)
  (backward-sequential-access-count 0 :type integer))
  
;;; ****s* snark-sparse-array/sparse-vector
;;; NAME
;;;   sparse-vector structure
;;;   sparse-vector type
;;; SOURCE

(defstruct (sparse-vector
            (:constructor make-sparse-vector0 (default-value boolean))
            (:print-function print-sparse-vector3)
            (:copier nil))
  (default-value nil :read-only t)
  (boolean nil :read-only t)
  (type nil)
  (count0 0 :type sparse-vector-count)
  (modification-count 0 :type integer)
  (cached-key 0 :type sparse-vector-index)
  (cached-value default-value)
  (b-tree-root-node nil)
  #+snark-sparse-vector-statistics (statistics (first (push (make-sparse-vector-stat :boolean boolean) *statistics*))))

;;; ***

;;; ****f* snark-sparse-array/make-sparse-vector
;;; USAGE
;;;   (make-sparse-vector &key boolean default-value)
;;; RETURN VALUE
;;;   sparse-vector
;;; SOURCE

(defun make-sparse-vector (&key boolean default-value)
  (when boolean
    (unless (null default-value)
      (error "Default-value must be NIL for Boolean sparse-arrays.")))
  (make-sparse-vector0 default-value boolean))
;;; ***

;;; ****f* snark-sparse-array/sparse-vector-p
;;; USAGE
;;;   (sparse-vector-p x)
;;; RETURN VALUE
;;;   true if x if a sparse-vector, false otherwise
;;; SOURCE

      ;;sparse-vector-p is defined by the sparse-vector defstruct
;;; ***

;;; ****f* snark-sparse-array/sparse-vector-boolean
;;; USAGE
;;;   (sparse-vector-boolean sparse-vector)
;;; RETURN VALUE
;;;   true if x is a boolean sparse-vector, false otherwise
;;; SOURCE

      ;;sparse-vector-boolean is defined as a slot in the sparse-vector structure
;;; ***

;;; ****f* snark-sparse-array/sparse-vector-default-value
;;; USAGE
;;;   (sparse-vector-boolean sparse-vector)
;;; RETURN VALUE
;;;   the default-value for unstored entries of sparse-vector
;;; SOURCE

      ;;sparse-vector-default-value is defined as a slot in the sparse-vector structure
;;; ***

;;; ****f* snark-sparse-array/sparse-vector-count
;;; USAGE
;;;   (sparse-vector-count sparse-vector)
;;; RETURN VALUE
;;;   integer number of entries in sparse-vector
;;; NOTES
;;;   returns 0 if sparse-vector is nil
;;; SOURCE

(definline sparse-vector-count (sparse-vector)
  (if (null sparse-vector) 0 (sparse-vector-count0 sparse-vector)))
;;; ***

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defconstant b-tree-node-size 16)			;must be even
  (defconstant b-tree-node-size-1 (- b-tree-node-size 1))
  (defconstant b-tree-node-size/2 (floor b-tree-node-size 2))
  (defconstant b-tree-node-size/2-1 (- b-tree-node-size/2 1)))

(deftype b-tree-node-index () #+ignore `(integer 0 ,b-tree-node-size-1) #-ignore 'fixnum)

(defstruct (b-tree-node
            (:constructor make-b-tree-node (leaf-p keys values last-index))
            )
  ;; b-tree nodes must be nonempty
  ;; leaf nodes have at least one key and the same number of values
  ;; nonleaf nodes have at least one value and one fewer key
  (leaf-p nil :read-only t)
  (last-index 0 :type b-tree-node-index)		;keys and values are stored from 0 through last-index
  (keys nil)						;list of keys
  (values nil))						;list of values (or nil for leaves if sparse vector is boolean)

(definline b-tree-leaf-search (keys index)
  ;; each leaf node has one or more keys in ascending order
  (declare (type sparse-vector-index index))
  (do ((k (carc keys) (carc keys*))
       (keys* (cdrc keys) (cdrc keys*))
       (i 0 (+ i 1)))
      ((null keys*)
       (if (= index k) (values t i) (values nil (if (< index k) i (+ i 1)))))
    (declare (type sparse-vector-index k) (type fixnum i))
    (when (<= index k)
      (return (values (= index k) i)))))

(definline b-tree-nonleaf-search (keys values index)
  ;; descend toward correct leaf node of b-tree index
  ;; each nonleaf node has one or more values and one fewer keys in ascending order
  ;; each values[i] is a b-tree that has keys less than or equal to keys[i]
  ;; except values[last] that has keys greater than keys[last-1]
  (declare (type sparse-vector-index index))
  (do ((keys keys (cdrc keys))
       (values values (cdrc values))
       (i 0 (+ i 1)))
      ((or (null keys) (<= index (the sparse-vector-index (carc keys))))
       (values (carc values) i))
    (declare (type b-tree-node-index i))))

(definline b-tree-node-first-key* (n)
  (declare (type b-tree-node n))
  (loop
    (if (b-tree-node-leaf-p n)
        (return (carc (b-tree-node-keys n)))
        (setf n (carc (b-tree-node-values n))))))

(definline b-tree-node-last-key* (n)
  (declare (type b-tree-node n))
  (loop
    (if (b-tree-node-leaf-p n)
        (return (carc (last (b-tree-node-keys n))))
        (setf n (carc (last (b-tree-node-values n)))))))

(defun nsplit (list num)
  (cond
   ((eql 0 num)
    nil)
   (t
    (dotimes (i (- num 1) (prog1 (rest list) (setf (rest list) nil)))
      (setf list (rest list))))))

(defmacro unroll-sparef1a ()
  (let ((l1 nil)
        (l2 nil)
        (label 'found-value))
    (dotimes (i b-tree-node-size)
      (cond
       ((= 0 i)
        (push `((or (null (setf keys (cdrc keys))) (<= index k))
                (when (= index k)
                  (if (null values) (go found-bool) (go ,label))))
              l1))
       ((> b-tree-node-size-1 i)
        (push `((progn (setf k (carc keys)) (or (null (setf keys (cdrc keys))) (<= index k)))
                (when (= index k)
                  (if (null values) (go found-bool) (go ,label))))
              l1))
       (t
        (push `((= index (carc keys))
                (if (null values) (go found-bool) (go ,label)))
              l1)))
      (cond
       ((= 0 i)
        )
       (t
        (push `(setf values (cdrc values)) l2)))
      (push label l2)
      (setf label (gensym)))    
    `(prog ((k (carc keys)))
       (declare (type sparse-vector-index k))
       (cond ,@(reverse l1))
       (setf (sparse-vector-cached-key sparse-vector) index)
       (return (setf (sparse-vector-cached-value sparse-vector) (sparse-vector-default-value sparse-vector)))
       found-bool
       (return (setf (sparse-vector-cached-value sparse-vector) (setf (sparse-vector-cached-key sparse-vector) index)))
       ,@l2
       (setf (sparse-vector-cached-key sparse-vector) index)
       (return (setf (sparse-vector-cached-value sparse-vector) (carc values))))))

(defmacro unroll-sparef1b ()
  `(cond
    ((or (null keys) (<= index (the sparse-vector-index (carc keys))))
     (carc values))
    ,@(consn `((progn (setf values (cdrc values)) (or (null (setf keys (cdrc keys))) (<= index (the sparse-vector-index (carc keys)))))
               (carc values))
             nil
             (- b-tree-node-size 2))
    (t
     (carc (cdrc values)))))

;;; ****if* snark-sparse-array/sparef1
;;; USAGE
;;;   (sparef1 sparse-vector index)
;;; NOTES
;;;   (sparef sparse-vector index) macroexpands to this
;;; SOURCE

(defun sparef1 (sparse-vector index)
  (declare (type sparse-vector sparse-vector) (type sparse-vector-index index))
  #+snark-sparse-vector-statistics (incf (sparse-vector-stat-random-access-count (sparse-vector-statistics sparse-vector)))
  (let ((n (sparse-vector-b-tree-root-node sparse-vector)))
    (cond
     ((null n)
      (sparse-vector-default-value sparse-vector))
     ((= (sparse-vector-cached-key sparse-vector) index)
      (sparse-vector-cached-value sparse-vector))
     (t
      (loop
        (let ((keys (b-tree-node-keys n))
              (values (b-tree-node-values n)))
          (cond
           ((or (null values) (b-tree-node-leaf-p n))
            (return (unroll-sparef1a)))
           (t
            (setf n (unroll-sparef1b))))))))))
;;; ***

;;; ****f* snark-sparse-array/sparef
;;; USAGE
;;;   (sparef sparse-vector index)
;;;   (setf (sparef sparse-vector index) value)
;;;
;;;   (sparef sparse-matrix row-index column-index)
;;;   (setf (sparef sparse-matrix row-index column-index) value)
;;; SOURCE

(defmacro sparef (sparse-array index1 &optional index2)
  (if (null index2)
      `(sparef1 ,sparse-array ,index1)
      `(sparef2 ,sparse-array ,index1 ,index2)))
;;; ***

;;; ****if* snark-sparse-array/sparse-vector-setter
;;; USAGE
;;;   (sparse-vector-setter value sparse-vector index)
;;; SOURCE

(defun sparse-vector-setter (value sparse-vector index)
  (declare (type sparse-vector sparse-vector) (type sparse-vector-index index))
  #+snark-sparse-vector-statistics (incf (sparse-vector-stat-assignment-count (sparse-vector-statistics sparse-vector)))
  (cond
   ((not (= (sparse-vector-cached-key sparse-vector) index))
    (setf (sparse-vector-cached-key sparse-vector) index)
    (setf (sparse-vector-cached-value sparse-vector) (if value (if (sparse-vector-boolean sparse-vector) index value) nil)))
   ((sparse-vector-boolean sparse-vector)
    (if (iff (sparse-vector-cached-value sparse-vector) value)
        (return-from sparse-vector-setter value)
        (setf (sparse-vector-cached-value sparse-vector) (if value index nil))))
   (t
    (if (eql (sparse-vector-cached-value sparse-vector) value)
        (return-from sparse-vector-setter value)
        (setf (sparse-vector-cached-value sparse-vector) value))))
  (let ((n (sparse-vector-b-tree-root-node sparse-vector)))
    (cond
     ((null n)
      ;; sparse-vector is empty
      (unless (eql (sparse-vector-default-value sparse-vector) value)
        ;; add single element
        (setf (sparse-vector-b-tree-root-node sparse-vector)
              (make-b-tree-node t (list index) (if (sparse-vector-boolean sparse-vector) nil (list value)) 0))
        (incf (sparse-vector-modification-count sparse-vector))
        (setf (sparse-vector-count0 sparse-vector) 1)))
     (t
      (labels
        ((b-tree-insert (n keys values last i index value leaf)
           (declare (type b-tree-node n) (type b-tree-node-index last) (type fixnum i))
;;         (cl:assert (implies (not leaf) (<= i last)))
           (cond
            ((> b-tree-node-size-1 last)
             ;; node is not full, insert new entry
             (cond
              ((= 0 i)
               (setf (b-tree-node-keys n) (cons index keys))
               (when values
                 (setf (b-tree-node-values n) (cons value values))))
              (t
               (if (and (not leaf) (= last i))
                   (nconc keys (list index))
                   (push index (cdrc (nthcdr (the fixnum (- i 1)) keys))))
               (when values
                 (push value (cdrc (nthcdr (the fixnum (- i 1)) values))))))
             (setf (b-tree-node-last-index n) (+ last 1))
             nil)
            ((= 0 i)
             ;; special case for adding before first entry of full node
             (let ((n2 (make-b-tree-node leaf (if leaf (list index) nil) (if (null values) nil (list value)) 0)))
               (values n2 (- (b-tree-node-first-key* n) 1))))
            ((< last i)
             ;; special case for adding after last entry of full node
             (let ((n2 (make-b-tree-node leaf keys values last)))
               (setf (b-tree-node-keys n) (if leaf (list index) nil))
               (when values
                 (setf (b-tree-node-values n) (list value)))
               (setf (b-tree-node-last-index n) 0)
               (values n2 (b-tree-node-last-key* n2))))
            (t
             ;; may not work if b-tree-node-size = 2
             (if (and (not leaf) (= last i))
                 (if (= 1 last)
                     (setf keys (list index))
                     (nconc keys (list index)))
                 (push index (cdrc (nthcdr (the fixnum (- i 1)) keys))))
             (when values
               (push value (cdrc (nthcdr (the fixnum (- i 1)) values))))
             (let ((n2 (make-b-tree-node leaf keys values b-tree-node-size/2-1)))
               (setf (b-tree-node-keys n) (if leaf (nsplit keys b-tree-node-size/2) (rest (nsplit keys b-tree-node-size/2-1))))
               (when values
                 (setf (b-tree-node-values n) (nsplit values b-tree-node-size/2)))
               (setf (b-tree-node-last-index n) b-tree-node-size/2)
               (values n2 (floor (+ (b-tree-node-last-key* n2) (- (b-tree-node-first-key* n) 1)) 2))))))
         (b-tree-delete (n keys values last i leaf)
           (declare (type b-tree-node n) (type b-tree-node-index last i))
           (cond
            ((= 0 last)
             :delete)
            (t
             (cond
              ((= 0 i)
               (setf (b-tree-node-keys n) (cdrc keys))
               (when values
                 (setf (b-tree-node-values n) (cdrc values))))
              (t
               (if (and (not leaf) (= last i))
                   (if (= 1 last)
                       (setf (b-tree-node-keys n) nil)
                       (nbutlast keys))
                   (pop (cdrc (nthcdr (the fixnum (- i 1)) keys))))
               (when values
                 (pop (cdrc (nthcdr (the fixnum (- i 1)) values))))))
             (setf (b-tree-node-last-index n) (- last 1))
             nil)))
         (sparse-vector-setter1 (n)
           (let ((keys (b-tree-node-keys n))
                 (values (b-tree-node-values n)))
             (cond
              ((or (null values) (b-tree-node-leaf-p n))
               ;; leaf node of b-tree index
               (multiple-value-bind (found i) (b-tree-leaf-search keys index)
                 (declare (type fixnum i))
                 (if found
                     (cond
                      ((eql (sparse-vector-default-value sparse-vector) value)
                       ;; delete this entry
                       (incf (sparse-vector-modification-count sparse-vector))
                       (decf (sparse-vector-count0 sparse-vector))
                       (b-tree-delete n keys values (b-tree-node-last-index n) i t))
                      (t	
                       ;; new value for this key
                       (when values
                         (setf (nth i values) value))
                       nil))
                     (cond
                      ((eql (sparse-vector-default-value sparse-vector) value)
                       ;; setting value for absent key to default-value is a nop
                       nil)
                      (t
                       (incf (sparse-vector-modification-count sparse-vector))
                       (incf (sparse-vector-count0 sparse-vector))
                       (b-tree-insert n keys values (b-tree-node-last-index n) i index value t))))))
              (t
               ;; descend toward correct leaf node of b-tree index
               (multiple-value-bind (v i) (b-tree-nonleaf-search keys values index)
                 (declare (type b-tree-node-index i))
                 (multiple-value-bind (n2 k2) (sparse-vector-setter1 v)
                   (when n2
                     (if (eq :delete n2)
                         (b-tree-delete n keys values (b-tree-node-last-index n) i nil)
                         (b-tree-insert n keys values (b-tree-node-last-index n) i k2 n2 nil))))))))))
        (multiple-value-bind (n2 k2) (sparse-vector-setter1 n)
          (when n2
            (if (eq :delete n2)
                (setf (sparse-vector-b-tree-root-node sparse-vector) nil)
                (setf (sparse-vector-b-tree-root-node sparse-vector) (make-b-tree-node nil (list k2) (list n2 n) 1)))))))))
  value)
;;; ***

;;; ****if* snark-sparse-array/map-sparse-vector0
;;; USAGE
;;;   (map-sparse-vector0 function sparse-vector reverse min max map)
;;; SOURCE

(defun map-sparse-vector0 (function sparse-vector reverse min max map)
  (declare (type sparse-vector sparse-vector))
  ;; always returns nil
  (macrolet
    ((apply-function (reverse start boolean)
       `(let ((k (carc keys)))
          (declare (type sparse-vector-index k))
          (cond
           ,@(when start
               (list (if reverse
                         '((and max (or (> k (the sparse-vector-index max)) (setf max nil)))
                           nil)
                         '((and min (or (< k (the sparse-vector-index min)) (setf min nil)))
                           ))))
           ,(if reverse
                '((and min (< k (the sparse-vector-index min)))
                  :stop)
                '((and max (> k (the sparse-vector-index max)))
                  (return :stop)))
           (t
            #+snark-sparse-vector-statistics
            (incf (,(if reverse
                        'sparse-vector-stat-backward-sequential-access-count
                        'sparse-vector-stat-forward-sequential-access-count)
                   (sparse-vector-statistics sparse-vector)))
            (cond
             ((null map)
              (funcall function ,(if boolean 'k '(carc values))))
             ((eq :with-indexes map)
              (funcall function ,(if boolean 'k '(carc values)) k))
             (t ;(eq :indexes-only map)
              (funcall function k)))
            ,(if reverse
                 '(unless (= modcount (sparse-vector-modification-count sparse-vector))
                    (setf max (- k 1))
                    :redo)
                 '(unless (= modcount (sparse-vector-modification-count sparse-vector))
                    (setf min (+ k 1))
                    (return :redo)))))))
     (do-map-sparse-vector1 ()
       `(labels
          ((map-sparse-vector1 (n)
             (map-sparse-vector1-body)))
          (map-sparse-vector1-body)))
     (map-leaf-backward (start boolean)
       (let ((form `(apply-function t ,start ,boolean)))
         (dotimes (i b-tree-node-size-1)
           (setf form `(or (let ((keys (cdrc keys))) (and keys ,(if boolean form `(let ((values (cdrc values))) ,form))))
                           (apply-function t ,start ,boolean))))
         `(let ((keys (b-tree-node-keys n))) ,form)))
     (map-nonleaf-backward-no-max ()
       (let ((form `(map-sparse-vector1 (carc values))))
         (dotimes (i b-tree-node-size-1)
           (setf form `(or (let ((values (cdrc values))) (and values ,form))
                           (map-sparse-vector1 (carc values)))))
         form)))
    (loop ;to repeat mapping if sparse-vector is modified during mapping
      (unless (eq :redo (and (implies (and min max) (<= (the sparse-vector-index min) (the sparse-vector-index max)))
                             (let ((n (sparse-vector-b-tree-root-node sparse-vector)))
                               (when n
                                 (let ((modcount (sparse-vector-modification-count sparse-vector)))
                                   (if reverse
                                       (if (null max)
                                           ;; backward iteration, no starting (maximum) key specified
                                           (macrolet
                                             ((map-sparse-vector1-body ()
                                                `(let ((values (b-tree-node-values n)))
                                                   (cond
                                                    ((null values)
                                                     (map-leaf-backward nil t))
                                                    ((b-tree-node-leaf-p n)
                                                     (map-leaf-backward nil nil))
                                                    (t
                                                     (map-nonleaf-backward-no-max))))))
                                             (do-map-sparse-vector1))
                                           ;; backward iteration, starting (maximum) key specified
                                           (macrolet
                                             ((map-sparse-vector1-body ()
                                                `(let ((values (b-tree-node-values n)))
                                                   (cond
                                                    ((null values)
                                                     (map-leaf-backward t t))
                                                    ((b-tree-node-leaf-p n)
                                                     (map-leaf-backward t nil))
                                                    (t ;nonleaf node
                                                     (labels
                                                       ((map1 (keys values)
                                                          (or (and (cdrc keys) (map1 (cdrc keys) (cdrc values)))
                                                              (cond
                                                               ((and max (>= (the sparse-vector-index (carc keys)) (the sparse-vector-index max)))
                                                                nil)
                                                               (t
                                                                (map-sparse-vector1 (carc values)))))))
                                                       (let ((keys (b-tree-node-keys n)))
                                                         (or (and keys (map1 keys (cdrc values)))
                                                             (map-sparse-vector1 (carc values))))))))))
                                             (do-map-sparse-vector1)))
                                       (if (null min)
                                           ;; forward iteration, no starting (minimum) key specified
                                           (macrolet
                                             ((map-sparse-vector1-body ()
                                                `(let ((values (b-tree-node-values n)))
                                                   (cond
                                                    ((null values)
                                                     (do ((keys (b-tree-node-keys n) (cdrc keys)))
                                                         ((null keys)
                                                          nil)
                                                       (apply-function nil nil t)))
                                                    ((b-tree-node-leaf-p n)
                                                     (do ((keys (b-tree-node-keys n) (cdrc keys))
                                                          (values values (cdrc values)))
                                                         ((null keys)
                                                          nil)
                                                       (apply-function nil nil nil)))
                                                    (t ;nonleaf node
                                                     (do ((values values (cdrc values))
                                                          v)
                                                         ((null values)
                                                          nil)
                                                       (cond
                                                        ((setf v (map-sparse-vector1 (carc values)))
                                                         (return v)))))))))
                                             (do-map-sparse-vector1))
                                           ;; forward iteration, starting (minimum) key specified
                                           (macrolet
                                             ((map-sparse-vector1-body ()
                                                `(let ((values (b-tree-node-values n)))
                                                   (cond
                                                    ((null values)
                                                     (do ((keys (b-tree-node-keys n) (cdrc keys)))
                                                         ((null keys)
                                                          nil)
                                                       (apply-function nil t t)))
                                                    ((b-tree-node-leaf-p n)
                                                     (do ((keys (b-tree-node-keys n) (cdrc keys))
                                                          (values values (cdrc values)))
                                                         ((null keys)
                                                          nil)
                                                       (apply-function nil t nil)))
                                                    (t ;nonleaf node
                                                     (do ((keys (b-tree-node-keys n) (cdrc keys))
                                                          (values values (cdrc values))
                                                          v)
                                                         ((null keys)
                                                          (map-sparse-vector1 (carc values)))
                                                       (cond
                                                        ((and min (< (the sparse-vector-index (carc keys)) (the sparse-vector-index min)))
                                                         )
                                                        ((setf v (map-sparse-vector1 (carc values)))
                                                         (return v)))))))))
                                             (do-map-sparse-vector1)))))))))
        (return nil)))))
;;; ***

;;; ****f* snark-sparse-array/map-sparse-vector
;;; USAGE
;;;   (map-sparse-vector function sparse-vector &key reverse min max)
;;; RETURN VALUE
;;;   nil
;;; DESCRIPTION
;;;   The map-sparse-vector function applies its unary-function argument to
;;;   each value (or index, if sparse-vector is boolean) in sparse-vector.
;;;   It does nothing if sparse-vector is nil.
;;;
;;;   The function is applied only to values whose index is >= min
;;;   and <= max if they are specified.  If reverse is nil, the
;;;   function is applied to values in ascending order by index;
;;;   otherwise, the order is reversed.
;;; SEE ALSO
;;;   map-sparse-vector-with-indexes
;;;   map-sparse-vector-indexes-only
;;; SOURCE

(definline map-sparse-vector (function sparse-vector &key reverse min max)
  (when sparse-vector
    (map-sparse-vector0 function sparse-vector reverse min max nil)))
;;; ***

;;; ****f* snark-sparse-array/map-sparse-vector-with-indexes
;;; USAGE
;;;   (map-sparse-vector-with-indexes function sparse-vector &key reverse min max)
;;; RETURN VALUE
;;;   nil
;;; DESCRIPTION
;;;   The map-sparse-vector-with-indexes function is like map-sparse-vector,
;;;   but applies its binary-function argument to each value and index in sparse-vector.
;;; SEE ALSO
;;;   map-sparse-vector
;;;   map-sparse-vector-indexes-only
;;; SOURCE

(definline map-sparse-vector-with-indexes (function sparse-vector &key reverse min max)
  (when sparse-vector
    (map-sparse-vector0 function sparse-vector reverse min max :with-indexes)))
;;; ***

;;; ****f* snark-sparse-array/map-sparse-vector-indexes-only
;;; USAGE
;;;   (map-sparse-vector-indexes-only function sparse-vector &key reverse min max)
;;; RETURN VALUE
;;;   nil
;;; DESCRIPTION
;;;   The map-sparse-vector-indexes-only function is like map-sparse-vector,
;;;   but applies its unary-function argument to each index in sparse-vector.
;;;   map-sparse-vector and map-sparse-vector-indexes-only operate identically
;;;   on boolean sparse-vectors.
;;; SEE ALSO
;;;   map-sparse-vector
;;;   map-sparse-vector-with-indexes
;;; SOURCE

(definline map-sparse-vector-indexes-only (function sparse-vector &key reverse min max)
  (when sparse-vector
    (map-sparse-vector0 function sparse-vector reverse min max :indexes-only)))
;;; ***

;;; ****f* snark-sparse-array/first-sparef
;;; USAGE
;;;   (first-sparef sparse-vector)
;;; RETURN VALUE
;;;   (values (sparef sparse-vector first-index) first-index) or
;;;   (values default-value nil) if sparse-vector is empty
;;; SEE ALSO
;;;   pop-first-sparef
;;; SOURCE

(defun first-sparef (sparse-vector)
  (declare (type sparse-vector sparse-vector))
  #+snark-sparse-vector-statistics (incf (sparse-vector-stat-random-access-count (sparse-vector-statistics sparse-vector)))
  (let ((n (sparse-vector-b-tree-root-node sparse-vector)))
    (cond
     ((null n)
      (values (sparse-vector-default-value sparse-vector) nil))
     (t
      (loop
        (let ((values (b-tree-node-values n)))
          (cond
           ((null values)
            (return (let ((k (carc (b-tree-node-keys n)))) (values k k))))
           ((b-tree-node-leaf-p n)
            (return (values (carc values) (carc (b-tree-node-keys n)))))
           (t
            (setf n (carc values))))))))))
;;; ***

;;; ****f* snark-sparse-array/last-sparef
;;; USAGE
;;;   (last-sparef sparse-vector)
;;; RETURN VALUE
;;;   (values (sparef sparse-vector last-index) last-index) or
;;;   (values default-value nil) if sparse-vector is empty
;;; SEE ALSO
;;;   pop-last-sparef
;;; SOURCE

(defun last-sparef (sparse-vector)
  (declare (type sparse-vector sparse-vector))
  #+snark-sparse-vector-statistics (incf (sparse-vector-stat-random-access-count (sparse-vector-statistics sparse-vector)))
  (let ((n (sparse-vector-b-tree-root-node sparse-vector)))
    (cond
     ((null n)
      (values (sparse-vector-default-value sparse-vector) nil))
     (t
      (loop
        (let ((values (b-tree-node-values n)))
          (cond
           ((null values)
            (return (let ((k (carc (last (b-tree-node-keys n))))) (values k k))))
           ((b-tree-node-leaf-p n)
            (return (values (carc (last values)) (carc (last (b-tree-node-keys n))))))
           (t
            (setf n (carc (last values)))))))))))
;;; ***

;;; ****f* snark-sparse-array/pop-first-sparef
;;; USAGE
;;;   (pop-first-sparef sparse-vector)
;;; RETURN VALUE
;;;   (values (sparef sparse-vector first-index) first-index) or
;;;   (values default-value nil) if sparse-vector is empty
;;; SIDE EFFECTS
;;;   removes it from sparse-vector
;;; SEE ALSO
;;;   first-sparef
;;; SOURCE

(defun pop-first-sparef (sparse-vector)
  (declare (type sparse-vector sparse-vector))
  (multiple-value-bind (value index) (first-sparef sparse-vector)
    (when index
      (sparse-vector-setter (sparse-vector-default-value sparse-vector) sparse-vector index))
    (values value index)))
;;; ***

;;; ****f* snark-sparse-array/pop-last-sparef
;;; USAGE
;;;   (pop-last-sparef sparse-vector)
;;; RETURN VALUE
;;;   (values (sparef sparse-vector last-index) last-index) or
;;;   (values default-value nil) if sparse-vector is empty
;;; SIDE EFFECTS
;;;   removes it from sparse-vector
;;; SEE ALSO
;;;   last-sparef
;;; SOURCE

(defun pop-last-sparef (sparse-vector)
  (declare (type sparse-vector sparse-vector))
  (multiple-value-bind (value index) (last-sparef sparse-vector)
    (when index
      (sparse-vector-setter (sparse-vector-default-value sparse-vector) sparse-vector index))
    (values value index)))
;;; ***

;;; sparse-vector3.lisp EOF
